home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / A-COMAL Series / (k)aaf.d64 / proc.xactcopy < prev    next >
Text File  |  2007-02-28  |  957b  |  32 lines
  1. 0010 //
  2. 0020 PROC XACTCOPY CLOSED
  3. 0030   USE SYSTEM
  4. 0040   USE FONT
  5. 0050   DIM RASTER$ OF 8
  6. 0060   DIM XRASTER$ OF 8
  7. 0070   SET:=PEEK($D018)
  8. 0080   IF SET=23 THEN CHARSET:=3
  9. 0090   IF SET=21 THEN CHARSET:=2
  10. 0100   IF SET=191 THEN CHARSET:=1
  11. 0110   IF SET=189 THEN CHARSET:=0
  12. 0120   RASTER$(1:8):=""
  13. 0130   XRASTER$(1:8):=""
  14. 0140   OPEN FILE 78,"U4:/T+/S0",WRITE
  15. 0150   PRINT FILE 78: CHR$(27),CHR$(65),CHR$(8)
  16. 0160   SCREENLOC:=PEEK($0288)*256
  17. 0170   FOR COL#:=0 TO 39 DO
  18. 0180     PRINT FILE 78: CHR$(27),CHR$(75),CHR$(200),CHR$(0),
  19. 0190     FOR LINE#:=24 TO 0 STEP -1 DO
  20. 0200       CHAR:=PEEK(SCREENLOC+LINE#*40+COL#)
  21. 0210       GETCHARACTER(CHARSET,CHAR,RASTER$)
  22. 0220       FOR FLIP:=1 TO 8 DO
  23. 0230         XRASTER$(9-FLIP):=RASTER$(FLIP)
  24. 0240       ENDFOR FLIP
  25. 0250       PRINT FILE 78: XRASTER$,
  26. 0260     ENDFOR LINE#
  27. 0270     PRINT FILE 78: CHR$(10)
  28. 0280   ENDFOR COL#
  29. 0290   PRINT FILE 78: CHR$(27),CHR$(64)
  30. 0300   CLOSE FILE 78
  31. 0310 ENDPROC XACTCOPY
  32.